home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / MacPerl5 / macscripts / Balloon2Rez < prev    next >
Encoding:
Text File  |  1996-01-27  |  2.8 KB  |  132 lines  |  [TEXT/MPS ]
  1. Perl -Sx "{0}" {"Parameters"}
  2. Exit 0
  3.  
  4. #!perl
  5. #
  6. # Balloon2Rez - High level language for creating dialog and menu balloon descriptions
  7. #
  8. # Written by              Peter Lewis        <peter.lewis@info.curtin.edu.au>
  9. # Some modifications by   Matthias Neeracher <neeri@iis.ee.ethz.ch>
  10. #
  11. # 04Dec94 MN removed hardcoded constants, allow some spacing flexibility
  12. #
  13.  
  14. $balloons_strh_id = 26724;
  15.  
  16. $in_name  = $ARGV[0];
  17. $in_name  =~ /^(.*)\.ball\w*$/i || die "Input needs suffix .ball*";
  18. $out_name = "$1.r";
  19.  
  20. open(STDIN,"$in_name") || die "Failed to open input \"$in_name\"";
  21. open(STDOUT,">$out_name") || die "Failed to open output \"$out_name\"";
  22.  
  23. print <<INCLUDES;
  24. #include "Types.r"
  25. #include "BalloonTypes.r"
  26.  
  27. INCLUDES
  28.  
  29. @strings=();
  30.  
  31. while (<>) {
  32.     chop;
  33.     next if /^$/;
  34.     last if /^END$/;
  35.     die "Bad line '$_'" unless /(DIALOG|MENU)\s+(\d+)\s*(.*)/;
  36.     $dialog = $1 eq "DIALOG"; $id = $2; $name=$3;
  37.     @items=();
  38.     @menus=();
  39.     $menuitem=0;
  40.     while (<>) {
  41.         chop;
  42.         next if /^\s*$/;
  43.         if ($dialog) {
  44.             last if /^END-DIALOG$/;
  45.             die "Quote in line '$_'" if /"/;
  46.             die "Bad dialog line '$_'" unless /^\s*(\d+)\.(\d+)\s+(.*)/;
  47.             ($item,$kind,$text) = ($1-1,$2,$3);
  48.         } else {
  49.             last if /^END-MENU$/;
  50.             die "Quote in line '$_'" if /"/;
  51.             die "Bad menu line '$_'" unless /^\s*(\d+)\.(\d)\s+(.*)/;
  52.             ($item,$kind,$text) = ($1,$2,$3);
  53.         }
  54.         $base=$item*4;
  55.         $item=$base+$kind-1;
  56.         $index = &find_string($text);
  57.         $items[$item] = $index;
  58.         $items[$base+0] = 0 unless $items[$base+0];
  59.         $items[$base+1] = 0 unless $items[$base+1];
  60.         $items[$base+2] = 0 unless $items[$base+2];
  61.         $items[$base+3] = 0 unless $items[$base+3];
  62.     }
  63.    if ($dialog) {
  64.        print <<"HEADER";
  65. resource 'hdlg' ($id,"$name") {
  66. \t2,0,0,0,0,
  67. \tHMSkipItem { },
  68. \t{
  69. HEADER
  70.     } else {
  71.       print <<"HEADER";
  72. resource 'hmnu' ($id,"$name") {
  73. \t2,0,0,0,
  74. \tHMSkipItem { },
  75. \t{
  76. HEADER
  77.     }
  78.     for $item (1..@items/4) {
  79.         $base = ($item-1)*4;
  80.         if ($items[$base+0] || $items[$base+1] ||
  81.              $items[$base+2] || $items[$base+3]) {
  82.             print "\t\tHMStringResItem { /* ", 
  83.                 ($dialog ? $item : ($item ? $item-1 : "title")),
  84.                 " */\n";
  85.             if ($dialog) {
  86.                 print <<"ITEM";
  87. \t\t\t{0,0},
  88. \t\t\t{0,0,0,0},
  89. ITEM
  90.             }
  91.             for $k (0..3) {
  92.                 $index = $items[$base+$k];
  93.                 if ($index) {
  94.                     print "\t\t\t$balloons_strh_id,$index,\n";
  95.                 } else {
  96.                     print "\t\t\t0,0,\n";
  97.                 }
  98.             }
  99.             print "\t\t},\n";
  100.         } else {
  101.             print "\t\tHMSkipItem { }, /* $item */\n";
  102.         }
  103.     }
  104.     print <<"TRAILER";
  105. \t}
  106. };
  107.  
  108. TRAILER
  109. }
  110.  
  111. print "resource 'STR#' ($balloons_strh_id,\"Balloon Help Strings\") {\n";
  112. print "\t{\n";
  113. for $index (1..@strings) {
  114.     print "\t\t/* $index */\n";
  115.     print "\t\t\"$strings[$index-1]\",\n";
  116. }
  117. print "\t}\n";
  118. print "};\n\n";
  119.  
  120. exit;
  121.  
  122. sub find_string {
  123.     local($s) = @_;
  124.     local($i);
  125.     for $i (1..@strings) {
  126.         return $i if $s eq $strings[$i-1];
  127.     }
  128.     $i = @strings;
  129.     $strings[$i] = $s;
  130.     return $i+1;
  131. }
  132.